home *** CD-ROM | disk | FTP | other *** search
/ Amiga Tools 3 / Amiga Tools 3.iso / rexx / cutpath.pvrx < prev    next >
Encoding:
Text File  |  1994-05-02  |  4.9 KB  |  188 lines
  1. /***************************************************************************
  2. *                                                                          *
  3. *  $VER: CutPath.pvrx 3.0 (02.May.94)                                      *
  4. *   Copyright © 1994 by Stylus, Inc.                                       *
  5. *   Author:  Jeff Blume                                                    *
  6. *                                                                          *
  7. *   This macro prompts user to select a point where a path should be cut.  *
  8. *   All points AFTER selected point become new object.                     *
  9. *                                                                          *
  10. *   Suggested "ProVector.pvrx" entries:                                    *
  11. *      'Define "CutPath        " "CutPath MENU"'                           *
  12. *                                                                          *
  13. *                                                                          *
  14. ***************************************************************************/
  15.  
  16. /*
  17. call open STDOUT,"RAM:RxOut.txt",W
  18. call open STDERR,"RAM:RxErr.txt",W
  19. trace R
  20. */
  21.  
  22. /* Get the argument list to see whether this is a MENU, or an OK */
  23. arg arglist
  24. Cmd = word(arglist,1)
  25.  
  26. options results
  27.  
  28. /* Try to get exclusive lock on project window.
  29.     If can't get lock, not polite to interrupt. */
  30. 'Lock'
  31. if RC ~= 0 then exit
  32.  
  33. /* This loop is called from the menu */
  34. if Cmd = 'MENU' then
  35. DO
  36.     /* Test Selected list for magnetized? */
  37.     /* Magnetize Sel Objs for better coord identification.*/
  38.     'SelectList' Sel; SelN = Result
  39.     if SelN ~= 1 then do
  40.         RC = 100
  41.         call Error "MUST SELECT ONE OBJECT ONLY!"
  42.         end
  43.     else 'Magnetize' SelN Sel
  44.     'TypeOf Sel.0'; ObjType = Result
  45.     call setclip "RepairType",""    /* NULL out flag */
  46.     select
  47.         when ObjType = "Polyline" then do
  48.             'Prompt "Click One Point To Cut:"'
  49.             'GetUserData 0 1 1 "CutPath OK" ""'
  50.             end
  51.         when ObjType = "Polygon" then do
  52.             'ChangeType Sel.0 Polyline'
  53.             'Repair'
  54.             'Prompt "Click One Point To Cut:"'
  55.             'GetUserData 0 1 1 "CutPath OK" ""'
  56.             'ChangeType Sel.0 "Polygon"'
  57.             call setclip "RepairType","1"
  58.             end
  59.         otherwise do
  60.             RC = 100
  61.             call Error "CAN'T CUT TEXT OR GROUP"
  62.             end
  63.     end /* SELECT END */
  64. END
  65. /* end "MENU" loop */
  66.  
  67. /* This was called from GetUserData */
  68. if Cmd = 'OK' then
  69. DO
  70.     'EndPrompt'
  71.     'GetInputPoints Pts'; NumIn=Result /* 1 or 2 */
  72.     'PushUndo'
  73.  
  74.     'Prompt "Looking for cut."'
  75.     'SelectList' Sel; SelN = Result
  76.     'TypeOf Sel.0'; ObjType = Result
  77.     'GetPoints' Sel.0 ObjPts; NumPts=Result
  78.  
  79.     /* Find Cut and build first new obj (Point 1 to Cut) */
  80.     do j = 0 to NumPts-1
  81.         select
  82.             when ObjPts.j.X = Pts.0.X & ObjPts.j.Y = Pts.0.Y then
  83.                 do
  84.                     ObjPtsA.j.X = ObjPts.j.X
  85.                     ObjPtsA.j.Y = ObjPts.j.Y
  86.                     Cut = j + 1        /* Clicked point stays with first part */
  87.                     NumPtsB = NumPts - j - 1
  88.                     if NumPtsB = 1 then do
  89.                         RC = 100
  90.                         call Error "CAN'T CUT 2ND TO LAST!"
  91.                         end
  92.                     if Cut = NumPts then do
  93.                         RC = 100
  94.                         call Error "CAN'T CUT LAST POINT!"
  95.                         end
  96.                     if Cut = 1 then do
  97.                         RC = 100
  98.                         call Error "CAN'T CUT FIRST POINT!"
  99.                         end
  100.                     call NoBeziers ObjPts,Cut
  101.                     leave j
  102.                 end
  103.             when j = NumPts-1 & Cut = "Cut" then do
  104.                         RC = 100
  105.                         call Error "CAN'T FIND CUT!"
  106.                         end
  107.             otherwise do
  108.                 ObjPtsA.j.X = ObjPts.j.X
  109.                 ObjPtsA.j.Y = ObjPts.j.Y
  110.                 end
  111.         end /* SELECT END */
  112.     end /* "j" DO END */
  113.     if ObjType = "Polyline" then 'Polyline' Cut ObjPtsA
  114.     else 'Polygon' Cut ObjPtsA
  115.  
  116.     /* Build second new obj (Cut to Point N) */
  117.     /* Discard first point if Sub-Poly Indicator
  118.         (all other indicators already trapped) */
  119.     if ObjPts.Cut.X = "INDICATOR" then do
  120.         Cut = Cut+1
  121.         NumPtsB = NumPtsB-1
  122.         end
  123.     do j = Cut to NumPts - 1
  124.         k = j - Cut
  125.         ObjPtsB.k.X = ObjPts.j.X
  126.         ObjPtsB.k.Y = ObjPts.j.Y
  127.     end
  128.     if ObjType = "Polyline" then 'Polyline' NumPtsB ObjPtsB
  129.     else 'Polygon' NumPtsB ObjPtsB
  130.  
  131. SAY "POLYGON RC = "||RC
  132. TRACE ?R
  133.  
  134.     /* De-Magnetize and Delete original obj; otherwise cleanup */
  135.     /* SelN = 0 */
  136.     'Magnetize' 0 Sel
  137.     'Delete' Sel.0
  138.     'EndPrompt'
  139.     'Repair'
  140. END
  141. /* end "OK" loop */
  142.  
  143. 'UnLock'
  144. EXIT
  145.  
  146.  
  147. ERROR:
  148.     arg ErrTxt
  149.     if RC ~= 0 & ErrTxt ~= "" then 'GetBool ErrTxt "Cancel" "Cancel"'
  150.     SelN = 0
  151.     'Magnetize' SelN Sel
  152.     'EndPrompt'
  153.     if getclip("RepairType")=1 then 'Repair'
  154.     'UnLock'
  155.     EXIT
  156.  
  157.  
  158. NOBEZIERS:        /* NO BEZIERS ON THIS BUS! (can't cut 'em) */
  159.     arg ObjPts,Cut
  160.     do t = Cut-2 to Cut-4 by -1    /* Cut OK at last pt of curve */
  161.         if ObjPts.t.X = "INDICATOR" & (ObjPts.t.Y = "1" | ObjPts.t.Y = "3") then do
  162.             RC = 100
  163.             call Error "Can't Cut Curves!"
  164.         end
  165.         if ObjPts.t.X = "INDICATOR" & ObjPts.t.Y = "2" then do
  166.             RC = 100
  167.             call Error "Can't Cut Sub-Poly Here"
  168.             /* Well, you could if macro supported it */
  169.         end
  170.     end
  171.     return
  172.  
  173.  
  174. FINDCUT:
  175.     arg Point,ObjPts,NumPts
  176.     do j = 0 to NumPts-1
  177.         select
  178.             when ObjPts.j.X = Point.X & ObjPts.j.Y = Point.Y then
  179.                 do
  180.                     Idx.k = j
  181.                     NmPts.k = NumPts
  182.                     return ObjPts.j
  183.                 end
  184.             when j = NumPts-1 then return "NO POINT"
  185.             otherwise iterate
  186.         end /*SELECT END*/
  187.     end /* "j" DO END */
  188.